home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tix4.1 / SWindow.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  6.8 KB  |  278 lines

  1. # SWindow.tcl --
  2. #
  3. #    This file implements Scrolled Window widgets
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11. #
  12. #
  13. # Example:
  14. #    
  15. #    tixScrolledWindow .w
  16. #    set window [.w subwidget window]
  17. #        # Now you can put a whole widget hierachy inside $window.
  18. #        #
  19. #    button $window.b
  20. #    pack $window.b
  21. #
  22. # Author's note
  23. #
  24. # Note, the current implementation does not allow the child window
  25. # to be outside of the parent window when the parent's size is larger
  26. # than the child's size. This is fine for normal operations. However,
  27. # it is not suitable for an MDI master window. Therefore, you will notice
  28. # that the MDI master window is not a subclass of ScrolledWidget at all.
  29. #
  30. #
  31.  
  32. tixWidgetClass tixScrolledWindow {
  33.     -classname TixScrolledWindow
  34.     -superclass tixScrolledWidget
  35.     -method {
  36.     }
  37.     -flag {
  38.     -expandmode -shrink -xscrollincrement -yscrollincrement
  39.     }
  40.     -static {
  41.     }
  42.     -configspec {
  43.     {-expandmode expandMode ExpandMode expand}
  44.     {-shrink shrink Shrink ""}
  45.     {-xscrollincrement xScrollIncrement ScrollIncrement ""}
  46.     {-yscrollincrement yScrollIncrement ScrollIncrement ""}
  47.  
  48.     {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
  49.     }
  50.     -default {
  51.     {.scrollbar            auto}
  52.     {*window.borderWidth        1}
  53.     {*f1.borderWidth        1}
  54.     {*Scrollbar.borderWidth        1}
  55.     {*Scrollbar.background        #d9d9d9}
  56.     {*Scrollbar.relief        sunken}
  57.     {*Scrollbar.troughColor        #c3c3c3}
  58.     {*Scrollbar.takeFocus        0}
  59.     {*Scrollbar.width        15}
  60.     }
  61. }
  62.  
  63. proc tixScrolledWindow:InitWidgetRec {w} {
  64.     upvar #0 $w data
  65.  
  66.     tixChainMethod $w InitWidgetRec
  67.  
  68.     set data(dx) 0
  69.     set data(dy) 0
  70. }
  71.  
  72. proc tixScrolledWindow:ConstructWidget {w} {
  73.     upvar #0 $w data
  74.     global tcl_platform
  75.  
  76.     tixChainMethod $w ConstructWidget
  77.  
  78.     set data(pw:f1) \
  79.     [frame $w.f1 -relief sunken]
  80.     set data(pw:f2) \
  81.     [frame $w.f2 -bd 0]
  82.     set data(w:window) \
  83.     [frame $w.f2.window -bd 0]
  84.     pack $data(pw:f2) -in $data(pw:f1) -expand yes -fill both
  85.  
  86.     set data(w:hsb) \
  87.     [scrollbar $w.hsb -orient horizontal -takefocus 0]
  88.     set data(w:vsb) \
  89.     [scrollbar $w.vsb -orient vertical -takefocus 0]
  90. #   set data(w:pann) \
  91. #    [frame $w.pann -bd 2 -relief groove]
  92.  
  93.     if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  94.         set data(w:sizebox) [ide_sizebox $w.sizebox]
  95.     }
  96.  
  97.     $data(pw:f1) config -highlightthickness \
  98.     [$data(w:hsb) cget -highlightthickness]
  99.  
  100.     set data(pw:client) $data(pw:f1)
  101. }
  102.  
  103. proc tixScrolledWindow:SetBindings {w} {
  104.     upvar #0 $w data
  105.  
  106.     tixChainMethod $w SetBindings
  107.  
  108.     $data(w:hsb) config -command "tixScrolledWindow:ScrollBarCB $w x"
  109.     $data(w:vsb) config -command "tixScrolledWindow:ScrollBarCB $w y"
  110.  
  111.     tixManageGeometry $data(w:window) "tixScrolledWindow:WindowGeomProc $w"
  112. }
  113.  
  114. # This guy just keeps asking for a same size as the w:window 
  115. #
  116. proc tixScrolledWindow:WindowGeomProc {w args} {
  117.     upvar #0 $w data
  118.  
  119.     set rw [winfo reqwidth  $data(w:window)]
  120.     set rh [winfo reqheight $data(w:window)]
  121.  
  122.     if {$rw != [winfo reqwidth  $data(pw:f2)] ||
  123.     $rh != [winfo reqheight $data(pw:f2)]} {
  124.     tixGeometryRequest $data(pw:f2) $rw $rh
  125.     }
  126. }
  127.  
  128. proc tixScrolledWindow:Scroll {w axis total window first args} {
  129.     upvar #0 $w data
  130.  
  131.     case [lindex $args 0] {
  132.     "scroll" {
  133.         set amt  [lindex $args 1]
  134.         set unit [lindex $args 2]
  135.  
  136.         case $unit {
  137.         "units" {
  138.             set incr $axis\scrollincrement
  139.             if {$data(-$incr) != ""} {
  140.             set by $data(-$incr)
  141.             } else {
  142.             set by [expr $window / 16]
  143.             }
  144.             set first [expr $first + $amt * $by]
  145.         }
  146.         "pages" {
  147.             set first [expr $first + $amt * $window]
  148.         }
  149.         }
  150.     }
  151.     "moveto" {
  152.         set to [lindex $args 1]
  153.         set first [expr int($to * $total)]
  154.     }
  155.     }
  156.  
  157.     if {[expr $first + $window] > $total} {
  158.     set first [expr $total - $window]
  159.     }
  160.     if {$first < 0} {
  161.     set first 0
  162.     }
  163.  
  164.     return $first
  165. }
  166.  
  167. proc tixScrolledWindow:ScrollBarCB {w axis args} {
  168.     upvar #0 $w data
  169.  
  170.     set bd \
  171.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  172.     set fw [expr [winfo width  $data(pw:f1)] - 2*$bd]
  173.     set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
  174.     set ww [winfo reqwidth  $data(w:window)]
  175.     set wh [winfo reqheight $data(w:window)]
  176.  
  177.     if {$axis == "x"} {
  178.     set data(dx) \
  179.         [eval tixScrolledWindow:Scroll $w $axis $ww $fw $data(dx) $args]
  180.     } else {
  181.     set data(dy) \
  182.         [eval tixScrolledWindow:Scroll $w $axis $wh $fh $data(dy) $args]
  183.     }
  184.  
  185.     tixWidgetDoWhenIdle tixScrolledWindow:PlaceWindow $w
  186. }
  187.  
  188. proc tixScrolledWindow:PlaceWindow {w} {
  189.     upvar #0 $w data
  190.  
  191.     set bd \
  192.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  193.     set fw [expr [winfo width  $data(pw:f1)] - 2*$bd]
  194.     set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
  195.     set ww [winfo reqwidth  $data(w:window)]
  196.     set wh [winfo reqheight $data(w:window)]
  197.  
  198.     tixMapWindow $data(w:window)
  199.  
  200.     if {$data(-expandmode) == "expand"} {
  201.     if {$ww < $fw} {
  202.         set ww $fw
  203.     }
  204.     if {$wh < $fh} {
  205.         set wh $fh
  206.     }
  207.     }
  208.     if {$data(-shrink) == "x"} {
  209.     if {$fw < $ww} {
  210.         set ww $fw
  211.     }
  212.     }
  213.  
  214.     tixMoveResizeWindow $data(w:window) -$data(dx) -$data(dy) $ww $wh
  215.  
  216.     set first [expr $data(dx).0 / $ww.0]
  217.     set last  [expr $first + ($fw.0 / $ww.0)]
  218.     $data(w:hsb) set $first $last
  219.  
  220.     set first [expr $data(dy).0 / $wh.0]
  221.     set last  [expr $first + ($fh.0 / $wh.0)]
  222.     $data(w:vsb) set $first $last
  223. }
  224.  
  225. #----------------------------------------------------------------------
  226. # virtual functions to query the client window's scroll requirement
  227. #
  228. # When this function is called, the scrolled window is going to be
  229. # mapped, if it is still unmapped. Also, it is going to change its
  230. # size. Therefore, it is a good time to check whether the w:window needs
  231. # to be re-positioned due to the new parent window size.
  232. #----------------------------------------------------------------------
  233. proc tixScrolledWindow:GeometryInfo {w mW mH} {
  234.     upvar #0 $w data
  235.  
  236.     set bd \
  237.        [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
  238.     set fw [expr $mW -2*$bd]
  239.     set fh [expr $mH -2*$bd]
  240.     set ww [winfo reqwidth  $data(w:window)]
  241.     set wh [winfo reqheight $data(w:window)]
  242.  
  243.     # Calculate the X info
  244.     #
  245.     if {$fw >= $ww} {
  246.     if {$data(dx) > 0} {
  247.         set data(dx) 0
  248.     }
  249.     set xinfo [list 0.0 1.0]
  250.     } else {
  251.     set maxdx [expr $ww - $fw]
  252.     if {$data(dx) > $maxdx} {
  253.         set data(dx) $maxdx
  254.     }
  255.     set first [expr $data(dx).0 / $ww.0]
  256.     set last  [expr $first + ($fw.0 / $ww.0)]
  257.     set xinfo [list $first $last]
  258.     }
  259.     # Calculate the Y info
  260.     #
  261.     if {$fh >= $wh} {
  262.     if {$data(dy) > 0} {
  263.         set data(dy) 0
  264.     }
  265.     set yinfo [list 0.0 1.0]
  266.     } else {
  267.     set maxdy [expr $wh - $fh]
  268.     if {$data(dy) > $maxdy} {
  269.         set data(dy) $maxdy
  270.     }
  271.     set first [expr $data(dy).0 / $wh.0]
  272.     set last  [expr $first + ($fh.0 / $wh.0)]
  273.     set yinfo [list $first $last]
  274.     }
  275.  
  276.     return [list $xinfo $yinfo]
  277. }
  278.